home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / nan_news / toolkit / ach2tb.prg < prev    next >
Text File  |  1991-08-15  |  27KB  |  645 lines
  1. /*
  2.  * File......: ACH2TB.PRG
  3.  * Author....: Steve Kolterman
  4.  * CIS ID....: 76320,37
  5.  * Date......: $Date:   15 Aug 1991 23:17:48  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/ach2tb.prv  $
  8.  * 
  9.  * This is an original work by Steve Kolterman and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/ach2tb.prv  $
  16.  * 
  17.  *    Rev 1.2   15 Aug 1991 23:17:48   GLENN
  18.  * Last minute fix sent in by Steve Kolterman
  19.  * 
  20.  *    Rev 1.1   15 Aug 1991 23:06:16   GLENN
  21.  * Forest Belt proofread/edited/cleaned up doc
  22.  * 
  23.  *    Rev 1.0   14 Jun 1991 04:14:14   GLENN
  24.  * Initial revision.
  25.  *
  26.  */
  27.  
  28. /*  $DOC$
  29.  *  $FUNCNAME$
  30.  *     FT_Ach2tb()
  31.  *  $ONELINER$
  32.  *     Replace ACHOICE() with a Tbrowse object
  33.  *  $CATEGORY$
  34.  *     Menus/Prompts
  35.  *  $SYNTAX$
  36.  *     FT_Ach2tb( <nToprow>,<nTopcol> [, <nBotrow> ][, <nBotcol> ],<aArray>,     ;
  37.  *           [ <cBoxtype> ],[ <cBoxcolor> ],[ <cBoxtitle> ],[ <nTitlePos> ],        ;
  38.  *           [ <cUselcolor> ],[ <cTitlecolor> ],[ <cBarcolor> ],[ <cHkcolor> ],     ;
  39.  *           [ <cShadow> ],[ <lExecute> ],[ <nMsgrow> ],[ <nMsgcol> ],              ;
  40.  *           [ <cMsgcolor> ],[cElevbar],[cEbarcolor],[ <cEbarside> ],          ;
  41.  *           [ <cNoSelcolor> ],[ <cTagch> ],[ <nStartelem> ],[ <lRestscrn> ],        ;
  42.  *           [ <nTimeout> ],[ <bUserfunc> ] )
  43.  *      -> nOption
  44.  *  $ARGUMENTS$
  45.  *  <nToprow>   is the top row of the box to be drawn.  Required.
  46.  *
  47.  *  <nTopcol>   is the top column of the box to be drawn.  Required.
  48.  *
  49.  *  <nBotrow>   is the bottom row of the box to be drawn.  The default is
  50.  *     <nToprow>+Len(<aArray>)+1 or maxrow()-2, whichever is less.
  51.  *
  52.  *  <nBotcol>   is the bottom column of the box to be drawn.  The default
  53.  *     is <nTopcol>+width of the widest element in <aArray>+2.
  54.  *
  55.  *  <aArray>    is the array of options to present to the user.  Each
  56.  *     element can hold as many as five subelements, or as few as one.
  57.  *     Required.  Additional documentation below, in "Description."
  58.  *
  59.  *  <cBoxtype> is the type of box to draw.  Uses DispBox().  The
  60.  *     default is a double-line box.
  61.  *
  62.  *  <cBoxcolor> is the color with which to draw the box.  The default is
  63.  *     Setcolor().
  64.  *
  65.  *  <cBoxtitle> is title of the box drawn on <nToprow>.  The default is
  66.  *     no title.
  67.  *
  68.  *  <nTitlepos>  is the starting column position (to the right of 
  69.  *     <nTopcol>) at which to draw <cBoxtitle>.  The default is 1.
  70.  *
  71.  *  <cUselcolor> is the color with which to draw unselected options.
  72.  *     The default is Setcolor().
  73.  *
  74.  *  <cTitlecolor> is the color with which to draw the box title.  The
  75.  *     default is yellow on red.
  76.  *
  77.  *  <cBarcolor>  is the color with which to draw the selection bar.
  78.  *     The default is yellow on black.
  79.  *
  80.  *  <cHkcolor>  is the default color with which to draw the hotkeys for
  81.  *     for each option.  This is used when no hotkey color is supplied
  82.  *     in <aArray>.  The default is hiwhite on the current background
  83.  *     color.
  84.  *
  85.  *  <cShadow>   is a character string, either "L" or "R" (for left or
  86.  *     right) to designate the side of the box where a shadow will appear.
  87.  *     Leave this NIL to avoid drawing a shadow.  You might also leave
  88.  *     this NIL if you choose to use a .C or .ASM shadow function, which
  89.  *     is a good idea.  Shadoww(), included below, is flat-out SLOW.
  90.  *
  91.  *  <lExecute>  turn on/off execution of option when first letter is
  92.  *     pressed.  Rule:  setting in element 5 of each <aArray> subarray
  93.  *     overrides <lExecute>.  If that element is left NIL, the <lexecute>
  94.  *     setting is used.  If <lExecute> is not passed and element 5 is NIL,
  95.  *     auto execution is turned ON by default.
  96.  *
  97.  *  <nMsgrow>  is the row on which to draw a message for each option.
  98.  *     The default is two rows below the bottom of the box.
  99.  *
  100.  *  <nMsgcol>  is the column at which to draw a message for each option.
  101.  *     The default is <nTopcol> +2.
  102.  *
  103.  *  <cMsgcolor>  is the default color with which to draw messages.  This
  104.  *     color is used when element 4 of each <aArray> subarray is left NIL.
  105.  *     The default is Setcolor().
  106.  *
  107.  *  <cElevbar>  is the ASCII character to use as the elevator bar drawn
  108.  *     on the box.  Leave this NIL to draw no elevator bar.
  109.  *
  110.  *  <cEbarcolor>  is the color with which to draw the elevator bar.
  111.  *     This is ignored if <cElevbar> is NIL.
  112.  *
  113.  *  <cEbarside>  is a character string, either "L" or "R" (for left or
  114.  *     right) to designate the side of the box on which to draw the
  115.  *     elevator bar.  This is ignored if <cElevbar> is NIL.
  116.  *
  117.  *  <cNoselcolor>  is the color with which to draw unselectable options.
  118.  *     The default is white on black.
  119.  *
  120.  *  <cTagchar> is the ASCII character to use to draw tags that would
  121.  *     appear to the right of each option.  The default is DISabled
  122.  *     tagging.  The default tag is "√" (chr(251)).
  123.  *
  124.  *  <nStartelem>  is the number of the option where the selection bar
  125.  *     will first be placed.  Leave this NIL to begin at option 1.
  126.  *
  127.  *  <lRestscrn>  is a logical to designate whether or not the screen
  128.  *     coordinates occupied by the box and/or shadow should be restored
  129.  *     before FT_Ach2tb() returns.  The default is .T.
  130.  *
  131.  *  <nTimeout>  is the number of seconds after which FT_ACH2TB() will
  132.  *     timeout and return to the function/proced. which called it.  The
  133.  *     default is 0, or no timeout.
  134.  *
  135.  *  <bUserfunc>  is a code block containing a function call to be
  136.  *     executed after each key press.  You need to write just two formal
  137.  *     parameters to allow the run-time passing of the key pressed and the
  138.  *     current element number, e.g.:
  139.  *
  140.  *     { | nKey, nElemnum | Myfunc( nKey, nElemnum [, xAnythingelse ] ) }
  141.  *
  142.  *     Unlimited extra parameters may be passed.  Of course, make certain
  143.  *     to also write 'receptors' for them in 'Myfunc()' itself...as in the
  144.  *     above example.  The default is NO user function.
  145.  *  $RETURNS$
  146.  *     the number of the selected option, or 0 if [Esc] is pressed.
  147.  *  $DESCRIPTION$
  148.  *     FT_Ach2tb() is a greatly enhanced, fully featured replacement for
  149.  *     Achoice(), based on a Tbrowse object.  Each element of <aArray> needs
  150.  *     to be composed as follows:
  151.  *
  152.  *         Option   ,     Message      , HotKeyPos, HotKeyColor, Selectable
  153.  *     { "Utilities","System Utilities",     3    ,   "+gr/b"  ,    .T.     }
  154.  *
  155.  *     All elements except for the first, the option itself, are optional.
  156.  *     IF 'Message' is NIL, no message is displayed.  'HotKeyPos' is the
  157.  *     position within 'Option' of the hotkey.  In the example above, the
  158.  *     hotkey for 'Utilities' is the first 'i', i.e., at position 3.  The
  159.  *     default is 1.  'HotKeyColor' is the color to use for the hotkey
  160.  *     display.  The default is hiwhite  on the current background color.
  161.  *     'Selectable' is a logical indicating whether or not that option can
  162.  *     be selected.  The default is .T.
  163.  *
  164.  *     The A_CHOICE() UDC in FT_ACH2T.CH makes using FT_ACH2TB() a breeze.
  165.  *     The myriad of parameters can be written in any order.  Only <nToprow>,
  166.  *     <nTopcol>, and <aArray> are required.  See the example below.
  167.  *
  168.  *     There may be some confusion over 'unselected' and 'unselectable'
  169.  *     options.  The former refers to any option not currently covered
  170.  *     by the selection bar.  The latter refers to options you have
  171.  *     designated unselectable in subelement 5 of <aArray>, i.e., by
  172.  *     writing .F.
  173.  *
  174.  *     To enable tagging, pass any ASCII character as <cTagchar>.  To
  175.  *     tag/untag all options, press [SPACE].  To tag/untag individual
  176.  *     options, press [+] and [-] respectively.  To test for the tagged
  177.  *     status of an option, use the WAS_TAGGED() UDC in FT_ACH2T.CH. To
  178.  *     check the entire array for tags, use Aeval() in conjunction with
  179.  *     Was_Tagged() as in the example below.  When tagging is enabled, the
  180.  *     string "Tags" will be written across the bottom row of the box in
  181.  *     hiwhite on the current background color.
  182.  *
  183.  *     Because FT_ACH2TB() takes over the [SPACE], [+], and [-] keys, it saves
  184.  *     any SET KEY procedures you might have set them to, and restores same
  185.  *     on returning.  Any other procedures you might have SET KEYs to will
  186.  *     fly when FT_ACH2TB() is called...thanks to the INKEY() replacement,
  187.  *     SKINKEY().
  188.  *
  189.  *     The piece de resistance of FT_ACH2TB() is its ability to execute
  190.  *     a user function designed entirely by you.  It is called after each
  191.  *     keypress, and because it is completely open-ended, extends the
  192.  *     the reach of FT_ACH2TB() to the limits of Clipper.  See the docu-
  193.  *     mentation under <bUserfunc> above.
  194.  *
  195.  *     Test compile:  CLIPPER ft_ach2t /n/w/m/dFT_TEST
  196.  *     Test link   :  RTLINK fi ft_ach2t /pll:base50
  197.  *
  198.  *  $EXAMPLES$
  199.  *     nOpt := A_CHOICE( 7,9 ARRAY:t_array USERFUNC:{|a,b| UserFunc(a,b,any1)};
  200.  *             BOXTYPE:B_SINGLE  BOXTITLE:title  SHADOW:"R" TAGCHAR:chr(17)   ;
  201.  *             REST_SCREEN:.F. AUTOEXEC:.F. MES_COLOR:MSG_COLOR ELEVBAR:"▒"   ;
  202.  *             NOSELCOLOR:"bg/n")
  203.  *
  204.  *     Check only the RETURNed element:
  205.  *     IF Was_Tagged(chr(17),t_array,nOpt); MoreProcessing(); END
  206.  *
  207.  *     Check entire 't_array':
  208.  *     Aeval( t_array,{|e,n| IF( Was_Tagged(chr(17),t_array,n ), ;
  209.  *                               MoreProcessing(t_array),NIL ) } )
  210.  *  $INCLUDE$
  211.  *     FT_ACH2T.CH
  212.  *  $SEEALSO$
  213.  *
  214.  *  $END$
  215.  */
  216.  
  217. #include "inkey.ch"
  218. #include "box.ch"
  219. #include "setcurs.ch"
  220. #include "ft_ach2t.ch"
  221.  
  222. #define KEY_ELEM         1
  223. #define BLK_ELEM         2
  224. #define AOPT             1
  225. #define AMSG             2
  226. #define AHOT             3
  227. #define ACLR             4
  228. #define ASEL             5
  229. #define HOTKEY_PRESS     (aelem > 0)
  230. #define METHOD_PRESS     (meth_num > 0 .and. meth_num <= 11)
  231. #define TAGS             ( tagchar<>NIL )
  232. #define TAG_PRESS        (TAGS .and. (meth_num > 11))
  233. #define CONTINUING       (lkey <> K_ESC)
  234. #define OUTTA_HERE       EXIT
  235. #define ATTOP            (aindex==1)
  236. #define ATBOTT           (aindex==Len(arrey))
  237. #define USEL_COLOR       FGColor(Setcolor())+"/"+BGColor(Setcolor())
  238. #define BARCOLOR         if(iscolor(),"+gr/n","n/w")
  239. #define TITLECOLOR       if(iscolor(),"+gr/r","n/w")
  240. #define DEMOCOLOR        if(iscolor(),"+gr/b","+w/n")
  241. #define HK_COLOR         if(iscolor(),"w+/"+ BGColor(setcolor()),"w+/n")
  242. #define SELECTABLE       (if(len(arrey[aindex])==5 .and. arrey[aindex][5]<> NIL,;
  243.                          arrey[aindex][5],aexec))
  244. #define NOSELECT         (len(arrey[aindex])==5 .and. !(arrey[aindex][5]))
  245. #define DEFAULT_TAG      "√"
  246. #define UP_ARROW_POS     t+2,col4bar
  247. #define DN_ARROW_POS     b-2,col4bar
  248. #define UP_ARROW         if(top_elem > 1,chr(24),chr(25))
  249. #define DN_ARROW         if(bot_elem < num_elems,chr(25),chr(24))
  250. #define GOING_UP         (Ltrim(str(meth_num)) $ "13579")
  251. #define GOING_DOWN       (Ltrim(str(meth_num)) $ "2468 10")
  252.  
  253. #xtranslate DISPMSG(<r>,<c>,<msg>[,<color>])           => ;
  254.             SetPos(<r>,<c>); DispOut(<msg>[,<color>])
  255. #translate  Clear([<t>,<l>,<b>,<r>])                   => ;
  256.             SCROLL([<t>,<l>,<b>,<r>])
  257. #command    DEFAULT <p> TO <val> [,<pn> TO <valn>]     => ;
  258.             <p> := IF( <p> == NIL, <val>, <p>) ;
  259.             [;<pn> := IF( <pn> == NIL, <valn>, <pn>)]
  260. #command    STABILIZE <o> => WHILE !<o>:stabilize(); END
  261.  
  262. #ifndef K_SPACEBAR
  263. #define K_SPACEBAR 32
  264. #endif
  265. #ifndef K_PLUS
  266. #define K_PLUS  43
  267. #define K_MINUS 45
  268. #endif
  269.  
  270. STATIC msg_len:= 0,dir:= "D"
  271.  
  272. #ifdef FT_TEST
  273.  
  274. Function Test( passes )
  275.  
  276. //                 Item       Msg         HotKeyPos/HotkeyColor/Selectable
  277. LOCAL t_arrey:= { {"Larry"   ,"larry"    ,   ,"w+/b"          },;
  278.                   {"Dick"    ,"dick"     ,   ,"b/r"           },;
  279.                   {"Harry"   ,           ,  3,       ,.F.     },;
  280.                   {"Steve"   ,"steve"    ,  4,"g/bg"          },;
  281.                   {"Michelle","michelle"                      },;
  282.                   {"Barnabas",           ,  6,"gr+/w"         },;
  283.                   {"Fred"    ,"fred"                          },;
  284.                   {"Lisa"    ,"lisa"     ,  3,"n/r"           },;
  285.                   {"Eleanor" ,"eleanor"  ,  4,"bg/r"          },;
  286.                   {"Anthony" ,"anthony"  ,  3                 },;
  287.                   {"Charles" ,"charles"  ,   ,       ,.F.     },;
  288.                   {"Ollie"   ,"ollie"    ,  4,"r/w"           },;
  289.                   {"George"  ,           ,  5                 },;
  290.                   {"Paula"   ,"paula"                         },;
  291.                   {"Jack"    ,"jack"     ,  4                 },;
  292.                   {"Quinten" ,"quinten"                       },;
  293.                   {"Nancy"   ,"nancy"    ,  5,"w/n"           },;
  294.                   {"Warren"  ,"warren"   ,  1,"n/gr*"         } }
  295. LOCAL t_arrey2:= {{"Warren"  ,"warren"   ,   ,"w+/b"          },;
  296.                   {"Charles" ,"charles"                       },;
  297.                   {"Ollie"   ,"ollie"    ,  4,"r/w"           },;
  298.                   {"George"  ,           ,  5                 },;
  299.                   {"Paula"   ,"paula"    ,  3,"gr+/bg"        },;
  300.                   {"Harry"   ,           ,  3,       ,.F.     },;
  301.                   {"Michelle","michelle" ,   ,"gr+/gr"        },;
  302.                   {"Anthony" ,"anthony"  ,  2                 } }
  303.  
  304.  
  305. LOCAL title:= " SK Test ",retval,xx,o_color:= Setcolor( DEMOCOLOR ),o_blink
  306. LOCAL any1:= "User function called!",retval2
  307. LOCAL any2:= "User function2 called!"
  308.  
  309. DEFAULT passes to 3; passes:= IF(valtype(passes)=="C",val(passes),passes)
  310.  
  311. Clear()
  312. o_blink:= SetBlink(.F.)
  313.  
  314. FOR xx:= 1 to passes
  315.   retval:= A_CHOICE( 7,9 ARRAY:t_arrey TITLEPOS:2 START_ELEM:retval ;
  316.            USERFUNC:{|a,b| UserFunc(a,b,any1,.F.,1,.T.)} ;
  317.            BOXTYPE:B_SINGLE  BOXTITLE:title  SHADOW:"R" TAGCHAR:chr(17);
  318.            REST_SCREEN:.F. AUTOEXEC:.F. MES_COLOR:"+w/b" ELEVBAR:"▒" )
  319.   @ 1,0 say "Returned element "+Ltrim(str(retval))+" "
  320.   IF retval > 0
  321.      @ 2,0 say "That was "+IF( Was_Tagged(chr(17),t_arrey,retval) ,;
  322.                "a Tagged","an UNtagged")+"  element  "
  323.   END
  324.   @ 3,0 say "Press, Please "; inkey(0)
  325.   Clear()
  326.   retval2:= A_CHOICE( 5,9 ARRAY:t_arrey2  BOXTYPE:B_DOUBLE ELEVBAR:"░" ;
  327.             BOXTITLE:" SK Test2 " AUTOEXEC:.T. ELEVBAR_COLOR:"+w/r" ;
  328.             MES_COLOR:"+w/gr" USERFUNC:{|a,b| UserFunc(a,b,any2,.T.,3,.F.,4)} ;
  329.             REST_SCREEN:.F. ELEVBAR_SIDE:"R" TIME_OUT:4 ;
  330.             START_ELEM:3 SHADOW:"L" BAR_COLOR:"+r/gr*" )
  331.   @ 1,0 say "Returned element "+Ltrim(str(retval2))+" "
  332.   IF retval2 > 0
  333.     @ 2,0 say "That was "+IF( Was_Tagged(DEFAULT_TAG,t_arrey2,retval2) ,;
  334.                "a Tagged","an UNtagged")+"  element  "
  335.   END
  336.   @ 3,0 say "Press, Please "; inkey(0)
  337.   Clear()
  338. NEXT
  339.  
  340. SetBlink(o_blink)
  341. QUIT
  342. RETURN NIL
  343.  
  344. #endif
  345.  
  346. FUNCTION FT_Ach2tb( t,l,b,r,arrey,boxtp,boxcolor,boxttl,ttlpos,uselcolor,;
  347.          ttlcolor,barcolor,hkcolor,shad,aexec,msg_row,msg_col,msg_color,;
  348.          ebar,ebarcolor,ebarside,noselcolor,tagchar,start_elem,r_screen,;
  349.          timeout,u_func )
  350.  
  351. LOCAL o_curs,lkey:= 0,meth_num:= 0,num_elems:= Len(arrey),ach_scrn,;
  352.       o_color,aelem:= 0,ex_req:= .F.,uf_cont:= .T.,top_elem,bot_elem,;
  353.       dm_color,o_blink,first_entry:= .T.,col4bar,didtag:=.F.,aindex, ;
  354.       a_chscrn,o_row:= Row(),o_col:= Col(),hotkeys[3],ab_methods,ab
  355.  
  356. DEFAULT boxtp TO B_DOUBLE,       ttlcolor TO TITLECOLOR,;
  357.         barcolor TO BARCOLOR,    r_screen TO .T. ,;
  358.         msg_col TO l+2,          noselcolor TO "w/n" ,;
  359.         msg_color TO USEL_COLOR, boxcolor TO setcolor(),;
  360.         uselcolor TO USEL_COLOR, aexec TO .T. ,;
  361.         ebarcolor TO Setcolor(), ;
  362.         ebarside TO "L",         start_elem TO 1 ,;
  363.         timeout TO 0,            ttlpos TO 1
  364.  
  365. o_curs := SetCursor(SC_NONE)
  366. SR_keys( "S",hotkeys )
  367. IF b==NIL
  368.    b:= IF( (t+Len(arrey)+1) >= maxrow()-2,maxrow()-2,(t+Len(arrey)+1) )
  369. END
  370. DEFAULT msg_row TO b+2
  371. r:= PrepArray( arrey,l,r,TAGS,tagchar )
  372. ach_scrn := SaveScreen( t,l-2,b+2,r+2 )
  373.  
  374. aindex:= 1
  375. ab:= tbrowsenew( t+1,l+1,b-1,r-1 )
  376. ab:addcolumn(tbcolumnnew("",{|| arrey[aindex][AOPT]} ))
  377. ab:getcolumn(1):width   := (r-1 -l)
  378. ab:gotopblock           := {|| aindex := 1}
  379. ab:gobottomblock        := {|| aindex := num_elems}
  380. ab:skipblock            := {|num_elems| Askip( num_elems,@aindex,arrey )}
  381. ab:colorspec            += ","+uselcolor+","+barcolor+","+noselcolor
  382. ab:getcolumn(1):colorblock:= { || ;
  383.                 IF(NOSELECT,{8},{6}) ,;
  384.                 ab:getcolumn(1):defcolor:= IF(NOSELECT,{8,8},{6,7}) }
  385.  
  386. ab_methods:= Curs_Methods()
  387.  
  388. PaintBox( t,l,b,r,boxtp,boxcolor,boxttl,ttlcolor,ttlpos,shad,TAGS )
  389. col4bar         := IF(upper(ebarside)=="L",l,r)
  390. IF ebar <> NIL  ;  ElevBar( t+1,col4bar,b,ebar,ebarcolor,ebarside ); END
  391.  
  392. ab:autolite(.F.)
  393.  
  394. WHILE CONTINUING
  395.  
  396.    DispBegin()
  397.    IF !ab:stable(); STABILIZE ab; END
  398.    IF NOSELECT; IF( dir=="U",ab:up(),ab:down() ); STABILIZE ab; END
  399.    top_elem:= 1+aindex-ab:rowpos; bot_elem:= top_elem+ab:rowcount-1
  400.  
  401.    IF first_entry .and. start_elem > 1
  402.       HotKeyPress( ab,arrey,start_elem,aindex,top_elem,bot_elem )
  403.       aindex:= start_elem
  404.       top_elem:= 1+aindex-ab:rowpos; bot_elem:= top_elem+ab:rowcount-1
  405.    END
  406.  
  407.    HotKeyColor( t,l,top_elem,arrey,ab:rowcount,hkcolor )
  408.    ab:hilite()
  409.  
  410.    DispMsgg( msg_row,msg_col,arrey,aindex,msg_color )
  411.    IF ebar <> NIL
  412.       DispMsg( UP_ARROW_POS,UP_ARROW,ebarcolor )
  413.       DispMsg( DN_ARROW_POS,DN_ARROW,ebarcolor )
  414.    END
  415.  
  416.    DispEnd()
  417.  
  418.    // idle mode
  419.    IF valtype(u_func)=="B"; uf_cont:= Eval( u_func,lkey,aindex ); END
  420.    IF ex_req .or. !uf_cont; OUTTA_HERE; ELSE; lkey:= 0; END
  421.  
  422.    ************************************
  423.    lkey     := SKInkey(timeout)
  424.    ************************************
  425.  
  426.    meth_num := Ascan( ab_methods, {|e| lkey == e[KEY_ELEM] })
  427.    aelem    := Ascan( arrey,{|e| IF(Len(e) >= AHOT .and. e[AHOT]<>NIL,;
  428.                       upper(chr(lkey)) == upper(subs(Ltrim(e[AOPT]),e[AHOT],1)) ,;
  429.                       upper(chr(lkey)) == upper(left(Ltrim(e[AOPT]),1)) ) } )
  430.  
  431.    IF HOTKEY_PRESS
  432.       HotKeyPress(ab,arrey,aelem,aindex,top_elem,bot_elem)
  433.       ex_req:= SELECTABLE; aindex:= aelem
  434.    ELSEIF METHOD_PRESS
  435.       ex_req:= Eval( ab_methods[meth_num][BLK_ELEM],ab,ATTOP,ATBOTT )
  436.       ex_req:= (ex_req .and. !NOSELECT)
  437.       dir   := IF(GOING_UP,"D",IF(GOING_DOWN,"U",dir) )
  438.    ELSEIF TAG_PRESS
  439.       didtag:= TagPress( ab,arrey,aindex,lkey,tagchar )
  440.    ENDIF
  441.  
  442.    IF lkey==0; ex_req:= .T.; END
  443.    first_entry:= .F.
  444.  
  445. ENDDO
  446.  
  447. Aeval( arrey,{|e| e[AOPT]:= Ltrim(e[AOPT]) } )
  448. SetPos(o_row,o_col); SetCursor(o_curs)
  449. IF r_screen; RestScreen( t,l-2,b+2,r+2,ach_scrn ); END
  450. SR_keys( "R",hotkeys )
  451. RETURN IF( lkey==K_ESC, 0, aindex )
  452. ************************************************************************
  453. STATIC FUNCTION Askip(num_elems, aindex, arrey)
  454. LOCAL save_aindex := aindex
  455. aindex:= IF( aindex+num_elems > Len(arrey), Len(arrey),;
  456.          IF( aindex+num_elems < 1, 1, aindex+num_elems ))
  457. RETURN (aindex - save_aindex)
  458. *************************************************************************
  459. STATIC FUNCTION HotKeyPress( ab,arrey,elem,aindex,top_elem,bot_elem )
  460. LOCAL cur_elem:= aindex,new_elem:= elem,dest
  461.  
  462. WHILE cur_elem < new_elem            // descending
  463.    dest:= MIN( new_elem,bot_elem ) ; dir:= "D"
  464.    WHILE cur_elem < dest; ab:down(); cur_elem++; END    // speeding
  465.    STABILIZE ab
  466.    WHILE cur_elem < new_elem ; ab:down() ; STABILIZE ab; cur_elem++; END
  467. END
  468. WHILE cur_elem > new_elem            // ascending
  469.    dest:= MAX( new_elem,top_elem ) ; dir:= "U"
  470.    WHILE cur_elem > dest; ab:up(); cur_elem--; END      // speeding
  471.    STABILIZE ab
  472.    WHILE cur_elem > new_elem ; ab:up()   ; STABILIZE ab; cur_elem--; END
  473. END
  474.  
  475. RETURN NIL
  476. *************************************************************************
  477. STATIC FUNCTION DispMsgg( r,c,arrey,pos,msg_color )
  478. LOCAL dm_color
  479. IF msg_len > 0
  480.    Clear( r,c,r,(c+msg_len) )
  481. END
  482. IF Len(arrey[pos]) >= AMSG .and. arrey[pos][AMSG] <> NIL  // if msg. to display
  483.    dm_color:= IF(Len(arrey[pos]) >= ACLR .and. arrey[pos][ACLR]<>NIL,;
  484.               arrey[pos][ACLR],msg_color)
  485.    DispMsg( r,c,arrey[pos][AMSG],dm_color )
  486.    msg_len:= Len(arrey[pos][AMSG])
  487. END
  488. RETURN NIL
  489. *************************************************************************
  490. /*
  491. this is here for test purposes.  the default is NO user func.
  492. */
  493. #ifdef FT_TEST
  494.  
  495. FUNCTION UserFunc( key,elem_num,anything,aexec,st_elem,tag,tmout )
  496. LOCAL ret_val:= .T.
  497. DEFAULT tmout TO 0
  498. @ 09,45 say "            LASTKEY: "+Ltrim(str(key))+"  "
  499. @ 10,45 say "CURRENT ELEMENT NUM: "+Ltrim(str(elem_num))+"  "
  500. @ 11,45 say "  AUTO-EXECUTION IS: "+if(aexec,"ON ","OFF")
  501. @ 12,45 say "STARTING AT ELEMENT: "+ltrim(str(st_elem))
  502. @ 13,45 say "         TAGGING IS: "+if(tag,"ENABLED ","DISABLED")
  503. @ 14,45 say "            TIMEOUT: "+if(tmout >0,ltrim(str(tmout))+" secs.  ",;
  504.                                     "INACTIVE      ")
  505. IF anything <> NIL; @ 16,45 say anything; END
  506.  
  507. /*
  508. return .F. if you want to leave FT_ACH2TB() after whatever
  509. processing you do here.
  510. */
  511.  
  512. RETURN (ret_val)
  513. #endif
  514.  
  515. **************************************************************************
  516. STATIC FUNCTION HotKeyColor( t,l,top_elem,arrey,rowcount,hkcolor )
  517. LOCAL i:= 0,color2use,col2use,charpos
  518.  
  519. #define ELEM2USE arrey[top_elem+i]
  520. #define CANT_SELECT (len(ELEM2USE)==5 .and. !ELEM2USE[ASEL])
  521.  
  522. Aeval( Array(rowcount),{|e,xx|  ;
  523.     color2use:= IF( Len(ELEM2USE) >=ACLR .and. ELEM2USE[ACLR]<>NIL,;
  524.                 ELEM2USE[ACLR], IF(hkcolor<>NIL,hkcolor,HK_COLOR) ),;
  525.     col2use:=   IF(len(ELEM2USE) >=AHOT .and. ELEM2USE[AHOT]<>NIL,;
  526.                 l+1+ELEM2USE[AHOT],l+2),;
  527.     charpos:=   IF(len(ELEM2USE) >=AHOT .and. ELEM2USE[AHOT]<>NIL,;
  528.                 ELEM2USE[AHOT],1 ) ,;
  529.     IF( !CANT_SELECT, SetPos( t+xx,col2use ),NIL)  ,;
  530.     IF( !CANT_SELECT, ;
  531.     DispOut( SUBS(Ltrim(ELEM2USE[AOPT]),charpos,1),color2use ),NIL)  ,;
  532.     i++ } )
  533.  
  534. RETURN NIL
  535. ****************************************************************************
  536. STATIC FUNCTION Curs_Methods()
  537. RETURN { ;
  538.          {K_DOWN,     {|b,s,e| IF(e,b:gotop(),   b:down()),     .F. } }, ;
  539.          {K_UP,       {|b,s,e| IF(s,b:gobottom(),b:up()),       .F. } }, ;
  540.          {K_PGDN,     {|b,s,e| IF(e,b:gotop(),   b:pagedown()), .F. } }, ;
  541.          {K_PGUP,     {|b,s,e| IF(s,b:gobottom(),b:pageup()),   .F. } }, ;
  542.          {K_CTRL_PGUP,{|b,s,e| IF(s,b:gobottom(),b:gotop()),    .F. } }, ;
  543.          {K_CTRL_PGDN,{|b,s,e| IF(e,b:gotop(),   b:gobottom()), .F. } }, ;
  544.          {K_CTRL_HOME,{|b,s,e| IF(s,b:gobottom(),b:gotop()),    .F. } }, ;
  545.          {K_CTRL_END, {|b,s,e| IF(e,b:gotop(),   b:gobottom()), .F. } }, ;
  546.          {K_HOME,     {|b,s,e| IF(s,b:gobottom(),b:gotop()),    .F. } }, ;
  547.          {K_END,      {|b,s,e| IF(e,b:gotop(),   b:gobottom()), .F. } }, ;
  548.          {K_ENTER,    {|b,s,e| .T. } },  ;
  549.          {K_SPACEBAR, {|b,s,e| .F. } },  ;
  550.          {K_PLUS,     {|b,s,e| .F. } },  ;
  551.          {K_MINUS,    {|b,s,e| .F. } }   ;
  552.        }
  553. ****************************************************************************
  554. STATIC FUNCTION ElevBar( t,col4bar,b,ebar,bcolor )
  555. LOCAL c:= 0
  556. Aeval( Array(b-t),{ |e,n| SetPos(t+c,col4bar),DispOut(ebar,bcolor),c++ })
  557. RETURN NIL
  558. ****************************************************************************
  559. #define TARGET   arrey[pos][AOPT]
  560. #define TAGGED   (tagchar $TARGET)
  561. #define AEV_TARG arrey[n][AOPT]
  562. #define AEV_TAGD (tagchar $AEV_TARG)
  563.  
  564. STATIC FUNCTION TagPress( ab,arrey,pos,lkey,tagchar )
  565. LOCAL didtag:= .F.
  566.  
  567. IF (lkey==K_PLUS .and. !TAGGED) .or. (lkey==K_MINUS .and. TAGGED)
  568.    TARGET:= IF( (lkey==K_PLUS .and. !TAGGED) ,;
  569.                 Left(TARGET,Len(TARGET)-1)+tagchar ,;
  570.             IF( (lkey==K_MINUS .and. TAGGED) ,;
  571.                 Strtran(TARGET,tagchar," ")  ,;
  572.                 TARGET ))
  573.    ab:refreshcurrent(); didtag:= .T.
  574. ENDIF
  575. IF lkey==K_SPACEBAR
  576.    IF !(Ascan(arrey,{|e| tagchar $ e[AOPT] }) > 0)
  577.       Aeval(arrey,{|e,n| AEV_TARG:= Left(AEV_TARG,Len(AEV_TARG)-1)+tagchar })
  578.    ELSE
  579.       Aeval(arrey,{|e,n| AEV_TARG:= Strtran(AEV_TARG,tagchar," ") })
  580.    END
  581.    ab:refreshall() ; didtag:= .T.
  582. ENDIF
  583. RETURN (didtag)
  584. ****************************************************************************
  585. STATIC FUNCTION PaintBox( t,l,b,r,boxtp,boxcolor,boxttl,ttlcolor,ttlpos,shad,tags )
  586. #translate CenterB( <b>,<l>,<r>,<msg>[,<color>] ) => ;
  587.            SetPos(<b>,(<l>+Int((<r>-<l> -Len(<msg>))/2) ) ) ;;
  588.            DispOut(<msg>[,<color>])
  589.  
  590.  IF shad <> NIL; Shadoww( t,l,b,r,upper(shad) ); END
  591.  DispBox( t,l,b,r,boxtp,boxcolor )
  592.  IF boxttl <> NIL; DispMsg( t,(l+ttlpos),boxttl,ttlcolor ); END
  593.  IF tags .and. (r-l) >= 4 
  594.     CenterB( b,l,r,"Tags","+w/"+BGColor(setcolor()) )
  595.  END
  596. RETURN NIL
  597. ****************************************************************************
  598. STATIC FUNCTION PrepArray( arrey,l,r,tags,tagchar )
  599. Aeval( arrey,{|e| e[AOPT]:= " " +AllTrim( ;
  600.                   IF(tags,StrTran(e[AOPT],tagchar),e[AOPT]) ) } )
  601. IF r==NIL; r:= 0
  602.    Aeval( arrey,{|e| r:= MAX( r,Len(e[AOPT]) ) }); r+= IF( !tags,(l+2),(l+3) )
  603. END
  604. IF tags; Aeval( arrey,{|e| e[AOPT]:= Padr(e[AOPT],r-l-1) }) ; END
  605. RETURN (r)
  606. *****************************************************************************
  607. STATIC FUNCTION BGColor( color )
  608. LOCAL startpos:= AT("/",color)+1
  609. LOCAL endpos:= IF( "," $ color,AT(",",color),len(color)+1 )
  610. RETURN upper(subs( color,startpos,(endpos-startpos) ))
  611. *****************************************************************************
  612. STATIC FUNCTION FGColor( color )
  613. RETURN upper(subs( color,1,AT("/",color)-1 ))
  614. *****************************************************************************
  615. STATIC FUNCTION SKInkey( num_secs )         // fake a wait state
  616. LOCAL iblock,key:= 0,looping:= .T.
  617. WHILE looping
  618.    key:= inkey( num_secs )
  619.    IF ( iblock := Setkey(key) ) <> NIL
  620.       Eval( iblock, procname(1), procline(1), readvar() )
  621.    ELSE; looping:= .F.
  622.    END
  623. END
  624. RETURN (key)
  625. ****************************************************************************
  626. STATIC FUNCTION SR_Keys( action,hotkeys )
  627. IF action=="S"
  628.    hotkeys[1] := Setkey(K_SPACEBAR) ; Setkey(K_SPACEBAR,NIL)
  629.    hotkeys[2] := Setkey(K_PLUS)     ; Setkey(K_PLUS,NIL)
  630.    hotkeys[3] := Setkey(K_MINUS)    ; Setkey(K_MINUS,NIL)
  631. ELSEIF action=="R"
  632.    Setkey(K_SPACEBAR,hotkeys[1])
  633.    Setkey(K_PLUS,hotkeys[2])
  634.    Setkey(K_MINUS,hotkeys[3])
  635. END
  636. RETURN NIL
  637. ****************************************************************************
  638. STATIC FUNCTION Shadoww( t,l,b,r,side )
  639. LOCAL bx
  640. DEFAULT side TO "R"
  641. l+= IF(side=="R",2,-2); r+= IF(side=="R",2,-2)
  642. bx:= SaveScreen( ++t,l,++b,r )
  643. RestScreen( t,l,b,r,Transf( bx,Replic("x"+chr(8),len(bx)/2) ) )
  644. RETURN NIL
  645.